perm filename NOIR.F4[1,MUS] blob
sn#075919 filedate 1973-12-01 generic text, type T, neo UTF8
00100 SUBROUTINE NOIR(RMINI)
00200 C BLACKS IN NOTES
00300 COMMON/DL/IXRX,Q,AA
00400 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00500 COMMON/PLTR/IPLT,RHT,DIS
00600 COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
00700 EQUIVALENCE (JF,JQ(4))
00800 DATA IXGP/1200/,BL/7.4/,BH/6.5/,CX/1.0/,FL/0.0/
00866 C ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
01000 JXGP=WDS(250)
01110 B=CENTR*RHT
01120 C=CX
01130 IF(B)C=-C
01140 KC=B+C
01155 D=RJB*DIS
01200 B=BH*RMINI*RHT
01300 A=BL*RMINI*DIS
01320 BX=.5
01340 IF(D)BX=-BX
01500 C=A+D+BX
01550 C ROUND-OFF MAY GIVE SMALL ERROR WHEN X COORD.=NEAR 0.
01600 A=A*A
01700 K=B+FL
01800 B=B*B
01900 C USES EQUATION FOR ELLIPSE
02000 N=1
02100 5 L=C
02200 JY=KC
02300 IF(IXRX.EQ.0)GO TO 4
02400 JY=IXGP+L
02500 L=JXGP-KC
02600 4 CALL PLOT(L,JY,3)
02700 6 DO 1 J=-K,K
02800 Y=J*J
02900 JY=J+KC
03000 X=SQRT(A-(A*Y)/B)
03100 L=C-X
03200 M=C+X
03300 C THE TWO SIDES OF THE LINE
03400 JZ=JY
03500 IF(N)CALL EXCH(L,M)
03900 IF(IXRX.EQ.0)GO TO 3
04000 I=L
04100 L=JXGP-JY
04200 JY=IXGP+I
04300 JZ=M
04400 M=L
04500 JZ=IXGP+JZ
04600 3 CALL PLOT(L,JY,2)
04700 CALL PLOT(M,JZ,2)
04800 1 N=-N
05000 END
06000
07000 SUBROUTINE NUMB
07200 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07300 DIMENSION ISU(320),R(8,100)
07500 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
07600 COMMON/POSI/STFF(8),JJB,POS/XRN/RN(4000)
07700 COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07800 EQUIVALENCE (RJD,RJQ(2)),(JF,JQ(4)),(RJE,RJQ(3)),
07900 1(ISU(1),ST(3600)),(R,RN(3001))
08000 CALL DPYSET(3,ISU,320)
08100 CALL DPYBRT(6)
08200 JF=1
08300 RA=100
08400 RB=R(3,1)
08500 POS=STFF(IFIX(RB)+4)
08600 RJD=RB+16.
08700 JA=5
08800 RJE=1
08900 DO 1 K=1,50
09000 IF(R(1,K).NE.1.OR.R(2,K).EQ.RA)GO TO 1
09100 IF(R(3,K).NE.RB)GO TO 2
09200 RA=R(2,K)
09300 C FOR DOUBLE STOPS
09400 JB=RHORZ(RA+2)
09600 CALL NOTWRT
09700 C GOES TO DRAW A NUMBER OVER A NOTE
09800 JF=JF+1
09900 IF(JF.EQ.10)JF=0
10000 1 IF(R(1,K).EQ.100)GO TO 2
10100 2 CALL DPYOUT(3)
10200 CALL SETPOG(1)
10400 END